home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Games / C-Pong / c-pong.p next >
Encoding:
Text File  |  1997-01-15  |  17.0 KB  |  729 lines  |  [TEXT/PJMM]
  1. program pong;
  2.  
  3.     uses
  4. {$IFC UNDEFINED THINK_PASCAL}
  5.         Types, QuickDraw, Events, Windows, Dialogs, Fonts, DiskInit, TextEdit, Traps,{}
  6.         Memory, SegLoad, Scrap, ToolUtils, OSUtils, Menus, Resources, StandardFile,{}
  7.         GestaltEqu, Files, Errors, Devices, QuickDrawText, TextUtils,{}
  8. {$ENDC}
  9.         Sound;
  10.  
  11. (*            pong.c}
  12. { The classic game of pong in Megamax C for the Mac.}
  13. { Thanks to MacTutor (Vol 1, No. 5 April 1985 page 39) for }
  14. { animation techniques. If you are reading this and don't  }
  15. { subscribe to MacTutor, consider it. No resource file is  }
  16. { needed. This program, source and object, is in the}
  17. { public domain and not for sale. }
  18. {  }
  19. { Author :    David L. O'Connor, 370 Eden St. Buffalo, N.Y. }
  20. {            14220.  (716) 828-0898.   CIS - 70265,1172 }
  21. { Date   :    July, 1985   Version 2}
  22. { }
  23. { }
  24. { Changes by Ingemar 1996:}
  25. { - Speed limit}
  26. { - Keyboard equivalents}
  27. { - Modern #includes}
  28. { - GetOSEvent makes it acceptably fast}
  29. {*)
  30.  
  31. (* the game diRections *)
  32.     const
  33.         STOPPED = 0;
  34.         UP = 1;
  35.         DOWN = 2;
  36.         LEFT = 3;
  37.         RIGHT = 4;
  38.         UP_LEFT = 5;
  39.         UP_RIGHT = 6;
  40.         DOWN_LEFT = 7;
  41.         DOWN_RIGHT = 8;
  42.  
  43. (* paddle + ball dimensions *)
  44.         PADWIDTH = 10;
  45.         PADLENGTH = 45;
  46.         PADINSET = 10;
  47.         BALLWIDTH = 9;
  48.         BALLLENGTH = 9;
  49.  
  50.         BALLSPEED = 7;
  51.         PADDLESPEED = 9;
  52.         HIGHSCORE = 21;
  53.  
  54. (* the menu ids *)
  55.         appleid = 128;
  56.         fileid = 129;
  57.         editid = 130;
  58.         skillid = 131;
  59.         soundid = 132;
  60.  
  61. (* from the MAC's standard pattern list *)
  62. {PAD_PAT= ((*pat_Handle)->pat_list[6]);}
  63. {WALL_PAT= ((*pat_Handle)->pat_list[10]);}
  64.     var
  65.         PAD_PAT: Pattern;
  66.         WALL_PAT: Pattern;
  67.  
  68.     type
  69.         sys_patterns = record
  70.                 pat_cnt: Integer;
  71.                 pat_list: array[0..37] of Pattern;
  72.             end;
  73.         SysPatternPtr = ^sys_patterns;
  74.         SysPatternHnd = ^SysPatternPtr;
  75.  
  76.     type
  77.         paddle = record
  78.                 r: Rect;
  79.                 dir: Integer;
  80.                 speed: Integer;
  81.                 score: Integer;
  82.             end;
  83.  
  84.     type
  85.         target = record
  86.                 Rgn: RgnHandle;
  87.                 oldRgn: RgnHandle;
  88.                 unRgn: RgnHandle;
  89.                 dir: Integer;
  90.                 speed: Integer;
  91.                 on: Boolean;
  92.             end;
  93.  
  94.     type
  95.         bleep_tag = record
  96.                 mode: Integer;
  97.                 triplet: array[0..0] of Tone;
  98.             end;
  99.  
  100.     type
  101.         blat_tag = record
  102.                 mode: Integer;
  103.                 triplet: array[0..1] of Tone;
  104.             end;
  105.  
  106.     var
  107.         bleep_buf: bleep_tag;
  108.         blat_buf: blat_tag;
  109.         l_paddle, r_paddle: paddle;
  110.         ball: target;
  111.         pat_Handle: SysPatternHnd;
  112.         gamewindow, which_window: WindowPtr;
  113.         winstorage: WindowRecord;
  114.         r, dragRect, top_wall, bottom_wall: Rect;
  115.         gameEvent: EventRecord;
  116.         gamemenu: array[0..4] of MenuHandle;
  117.         menutitle: array[0..0] of char;
  118.         skill_level, last_won, volleys: Integer;
  119.         done, paused, sound_on: Boolean;
  120.  
  121.     const
  122.         kTitle = '        Left  00                MAC_Pong                Right 00        ';
  123.     var
  124.         title: Str255;
  125.  
  126. (* Every so often, let the Mac's paddle fail to track the ball until}
  127. {   the ball has passed it by a certain amount.}
  128. {   This is the heart of a satisfying game. *)
  129.  
  130.     function handicap: Integer;
  131.         var
  132.             mac_skill: Integer;
  133.     begin
  134.         case skill_level of
  135.             1: 
  136.                 mac_skill := 2;
  137.             2: 
  138.                 mac_skill := 8;
  139.             3: 
  140.                 mac_skill := 27;
  141.             4: 
  142.                 mac_skill := 64;
  143.             otherwise
  144.                 mac_skill := 2;
  145.         end; {case}
  146.         if Random mod mac_skill = 0 then
  147.             handicap := 5
  148.         else
  149.             handicap := 0;
  150.     end;
  151.  
  152.     procedure blat;
  153.     begin
  154.         if (sound_on) then
  155.             begin
  156.                 if (not SoundDone) then
  157.                     StopSound;
  158.                 StartSound(Ptr(@blat_buf), sizeof(blat_buf), nil);
  159.             end;
  160.     end;
  161.  
  162.     procedure bleep;
  163.     begin
  164.         if (sound_on) then
  165.             begin
  166.                 if (not SoundDone) then
  167.                     StopSound;
  168.                 StartSound(Ptr(@bleep_buf), sizeof(bleep_buf), nil);
  169.             end;
  170.     end;
  171.  
  172.     procedure display_score;
  173.         var
  174.             i: LongInt;
  175.     begin
  176.         i := l_paddle.score;
  177.         title[15] := Char($30 + (i div 100));
  178.         title[16] := Char($30 + ((i mod 100) div 10));
  179.         title[17] := Char($30 + (i mod 10));
  180.         i := r_paddle.score;
  181.         title[63] := Char($30 + (i div 100));
  182.         title[64] := Char($30 + ((i mod 100) div 10));
  183.         title[65] := Char($30 + (i mod 10));
  184.         SetWTitle(gamewindow, title);
  185.     end;
  186.  
  187. (* the ball eats the walls and paddles *)
  188.  
  189.     procedure recover_from_collision;
  190.         var
  191.             rp: Rect;
  192.     begin
  193.         rp := ball.unRgn^^.rgnBBox;
  194.  
  195.         if (SectRect(rp, top_wall, r)) then
  196.             FillRect(r, WALL_PAT)
  197.         else if (SectRect(rp, bottom_wall, r)) then
  198.             FillRect(r, WALL_PAT);
  199.         if (SectRect(rp, l_paddle.r, r)) then
  200.             FillRect(r, PAD_PAT)
  201.         else if (SectRect(rp, r_paddle.r, r)) then
  202.             FillRect(r, PAD_PAT);
  203.     end;
  204.  
  205.     procedure move_ball;
  206.     begin
  207.         if (ball.on) then
  208.             begin
  209.                 CopyRgn(ball.Rgn, ball.oldRgn);
  210.                 case ball.dir of
  211.                     LEFT: 
  212.                         OffsetRgn(ball.Rgn, -ball.speed, 0);
  213.                     RIGHT: 
  214.                         OffsetRgn(ball.Rgn, ball.speed, 0);
  215.                     UP_LEFT: 
  216.                         OffsetRgn(ball.Rgn, -ball.speed, -ball.speed);
  217.                     UP_RIGHT: 
  218.                         OffsetRgn(ball.Rgn, ball.speed, -ball.speed);
  219.                     DOWN_LEFT: 
  220.                         OffsetRgn(ball.Rgn, -ball.speed, ball.speed);
  221.                     DOWN_RIGHT: 
  222.                         OffsetRgn(ball.Rgn, ball.speed, ball.speed);
  223.                 end; {case}
  224.                 UnionRgn(ball.Rgn, ball.oldRgn, ball.unRgn);
  225.                 DiffRgn(ball.unRgn, ball.Rgn, ball.unRgn);
  226.                 EraseRgn(ball.unRgn);
  227.                 PaintRgn(ball.Rgn);
  228.                 recover_from_collision;
  229.             end;
  230.     end;
  231.  
  232.     procedure move_right_paddle;
  233.     begin
  234.         if (r_paddle.dir = STOPPED) then
  235.             FillRect(r_paddle.r, PAD_PAT)
  236.         else
  237.             begin
  238.                 r.left := r_paddle.r.left;
  239.                 r.right := r_paddle.r.right;
  240.                 case r_paddle.dir of
  241.                     UP: 
  242.                         begin
  243.                             r.bottom := r_paddle.r.bottom;
  244.                             r_paddle.r.top := r_paddle.r.top - r_paddle.speed;
  245.                             r_paddle.r.bottom := r_paddle.r.bottom - r_paddle.speed;
  246.                             r.top := r_paddle.r.bottom;
  247.                         end;
  248.                     DOWN: 
  249.                         begin
  250.                             r.top := r_paddle.r.top;
  251.                             r_paddle.r.top := r_paddle.r.top + r_paddle.speed;
  252.                             r_paddle.r.bottom := r_paddle.r.bottom + r_paddle.speed;
  253.                             r.bottom := r_paddle.r.top;
  254.                         end;
  255.                 end;
  256.                 EraseRect(r);
  257.                 FillRect(r_paddle.r, PAD_PAT);
  258.             end;
  259.     end;
  260.  
  261.     procedure move_left_paddle;
  262.         var
  263.             mouseloc: Point;
  264.             newtop, newbottom: Integer;
  265.     begin
  266.         GetMouse(mouseloc);
  267.         if (mouseloc.v <> l_paddle.r.top) then
  268.             begin
  269.                 r.left := l_paddle.r.left;
  270.                 r.right := l_paddle.r.right;
  271.                 if (mouseloc.v <= winstorage.port.portRect.top) then
  272.                     begin
  273.                         newtop := winstorage.port.portRect.top;
  274.                         newbottom := newtop + PADLENGTH;
  275.                     end
  276.                 else if (mouseloc.v + PADLENGTH >= winstorage.port.portRect.bottom) then
  277.                     begin
  278.                         newbottom := winstorage.port.portRect.bottom;
  279.                         newtop := newbottom - PADLENGTH;
  280.                     end
  281.                 else
  282.                     begin
  283.                         newtop := mouseloc.v;
  284.                         newbottom := newtop + PADLENGTH;
  285.                     end;
  286.                 if (newtop > l_paddle.r.top) then
  287.                     begin
  288.                         r.top := l_paddle.r.top;
  289.                         if newtop > l_paddle.r.bottom then
  290.                             r.bottom := l_paddle.r.bottom
  291.                         else
  292.                             r.bottom := newtop;
  293.                     end
  294.                 else if (newtop < l_paddle.r.top) then
  295.                     begin
  296.                         r.bottom := l_paddle.r.bottom;
  297.                         if (newbottom < l_paddle.r.top) then
  298.                             r.top := l_paddle.r.top
  299.                         else
  300.                             r.top := newbottom;
  301.                     end;
  302.                 l_paddle.r.top := newtop;
  303.                 l_paddle.r.bottom := newbottom;
  304.                 EraseRect(r);
  305.                 FillRect(l_paddle.r, PAD_PAT);
  306.             end
  307.         else
  308.             FillRect(l_paddle.r, PAD_PAT);
  309.     end;
  310.  
  311. (* someone scored a point *)
  312.     procedure kill_ball;
  313.     begin
  314.         ball.on := false;
  315.         volleys := 0;
  316.         CopyRgn(ball.Rgn, ball.unRgn);
  317.         EraseRgn(ball.Rgn);
  318.         recover_from_collision;
  319.         blat;
  320.         display_score;
  321.     end;
  322.  
  323. (* check for bounces, diRection changes, scoring, etc *)
  324.     procedure check_status;
  325.         var
  326.             ball_r: Rect;
  327.             ball_top, ball_bottom, ball_left, ball_right: Integer;
  328.     begin
  329.         ball_top := ball.Rgn^^.rgnBBox.top;
  330.         ball_bottom := ball.Rgn^^.rgnBBox.bottom;
  331.         ball_left := ball.Rgn^^.rgnBBox.left;
  332.         ball_right := ball.Rgn^^.rgnBBox.right;
  333.  
  334.         ball_r := ball.Rgn^^.rgnBBox;
  335.  
  336.     (* make it a little harder as time goes by *)
  337.         if (volleys > 35) then
  338.             ball.speed := BALLSPEED + 6
  339.         else if (volleys > 30) then
  340.             ball.speed := BALLSPEED + 5
  341.         else if (volleys > 25) then
  342.             ball.speed := BALLSPEED + 4
  343.         else if (volleys > 20) then
  344.             ball.speed := BALLSPEED + 3
  345.         else if (volleys > 15) then
  346.             ball.speed := BALLSPEED + 2
  347.         else if (volleys > 10) then
  348.             ball.speed := BALLSPEED + 1;
  349.  
  350.         r_paddle.speed := ball.speed + 2;
  351.  
  352.     (* the right paddle tries to track the ball *)
  353.         if ((ball_right > 250) and (ball.dir = UP_RIGHT) or (ball.dir = DOWN_RIGHT) or (ball.dir = RIGHT)) then
  354.             begin
  355.                 if (ball_top + handicap < r_paddle.r.top) then
  356.                     r_paddle.dir := UP
  357.                 else if (ball_bottom - handicap > r_paddle.r.bottom) then
  358.                     r_paddle.dir := DOWN
  359.                 else
  360.                     r_paddle.dir := STOPPED;
  361.             end
  362.         else
  363.             r_paddle.dir := STOPPED;
  364.  
  365.     (* the ball and the left boundry *)
  366.         if (ball_left < l_paddle.r.right) then
  367.             begin
  368.                 if (SectRect(ball_r, l_paddle.r, r)) then
  369.                     begin
  370.                         volleys := volleys + 1;
  371.                         bleep;
  372.                         if (ball_top <= l_paddle.r.top + 15) then
  373.                             ball.dir := UP_RIGHT
  374.                         else if (ball_top > l_paddle.r.top + 15) and (ball_bottom < l_paddle.r.top + 30) then
  375.                             ball.dir := RIGHT
  376.                         else
  377.                             ball.dir := DOWN_RIGHT;
  378.                     end
  379.                 else
  380.                     begin
  381.                         last_won := RIGHT;
  382.                         r_paddle.score := r_paddle.score + 1;
  383.                         kill_ball;
  384.                     end;
  385.                 Exit(check_status);
  386.             end;
  387.  
  388.     (* the ball and the right boundry *)
  389.         if (ball_right > r_paddle.r.left) then
  390.             begin
  391.                 if (SectRect(ball_r, r_paddle.r, r)) then
  392.                     begin
  393.                         volleys := volleys + 1;
  394.                         bleep;
  395.                         if (ball_top <= r_paddle.r.top + 15) then
  396.                             ball.dir := UP_LEFT
  397.                         else if (ball_top > r_paddle.r.top + 15) and (ball_bottom < r_paddle.r.top + 30) then
  398.                             ball.dir := LEFT
  399.                         else
  400.                             ball.dir := DOWN_LEFT;
  401.                     end
  402.                 else
  403.                     begin
  404.                         last_won := LEFT;
  405.                         l_paddle.score := l_paddle.score + 1;
  406.                         kill_ball;
  407.                     end;
  408.                 Exit(check_status);
  409.             end;
  410.  
  411.     (* the ball and the top wall *)
  412.         if (ball_top < top_wall.bottom) then
  413.             begin
  414.                 if (ball.dir = UP_LEFT) then
  415.                     ball.dir := DOWN_LEFT
  416.                 else if (ball.dir = UP_RIGHT) then
  417.                     ball.dir := DOWN_RIGHT;
  418.                 bleep;
  419.                 Exit(check_status);
  420.             end;
  421.  
  422.     (* the ball and the bottom wall *)
  423.         if (ball_bottom > bottom_wall.top) then
  424.             begin
  425.                 if (ball.dir = DOWN_LEFT) then
  426.                     ball.dir := UP_LEFT
  427.                 else if (ball.dir = DOWN_RIGHT) then
  428.                     ball.dir := UP_RIGHT;
  429.                 bleep;
  430.                 Exit(check_status);
  431.             end;
  432.     end; {check_status}
  433.  
  434.     procedure Init_game;
  435.     begin
  436.         l_paddle.score := 0;
  437.         r_paddle.score := 0;
  438.         ball.speed := BALLSPEED;
  439.         kill_ball;
  440.     end;
  441.  
  442.     procedure serve_ball;
  443.         var
  444.             i: Integer;
  445.     begin
  446.         OffsetRgn(ball.Rgn, 250 - ball.Rgn^^.rgnBBox.right, 150 - (ball.Rgn^^.rgnBBox.top));
  447.         for i := 0 to 249 do
  448.             begin
  449.                 check_status;
  450.                 move_right_paddle;
  451.                 move_left_paddle;
  452.                 move_ball;
  453.             end;
  454.         if last_won = RIGHT then
  455.             ball.dir := LEFT
  456.         else
  457.             ball.dir := RIGHT;
  458.         ball.speed := BALLSPEED;
  459.         ball.on := true;
  460.         PaintRgn(ball.Rgn);
  461.         bleep;
  462.     end;
  463.  
  464.     procedure create_ball;
  465.     begin
  466.         ball.Rgn := NewRgn;
  467.         ball.oldRgn := NewRgn;
  468.         ball.unRgn := NewRgn;
  469.         ball.dir := LEFT;
  470.         ball.speed := BALLSPEED;
  471.         SetRect(r, 250, 150, 250 + BALLWIDTH, 150 + BALLLENGTH);
  472.         OpenRgn;
  473.         FrameOval(r);
  474.         CloseRgn(ball.Rgn);
  475.     end;
  476.  
  477.     procedure create_walls;
  478.     begin
  479.         SetRect(top_wall, winstorage.port.portRect.left + 20, winstorage.port.portRect.top + 5, winstorage.port.portRect.right - 20, winstorage.port.portRect.top + 20);
  480.         FillRect(top_wall, WALL_PAT);
  481.         SetRect(bottom_wall, winstorage.port.portRect.left + 20, winstorage.port.portRect.bottom - 20, winstorage.port.portRect.right - 20, winstorage.port.portRect.bottom - 5);
  482.         FillRect(bottom_wall, WALL_PAT);
  483.     end;
  484.  
  485.     procedure create_r_paddle;
  486.     begin
  487.         r_paddle.dir := STOPPED;
  488.         r_paddle.speed := PADDLESPEED;
  489.         r_paddle.score := 0;
  490.         SetRect(r_paddle.r, winstorage.port.portRect.right - PADWIDTH - PADINSET, winstorage.port.portRect.top + PADINSET, winstorage.port.portRect.right - PADWIDTH - PADINSET + PADWIDTH, winstorage.port.portRect.top + PADINSET + PADLENGTH);
  491.         FillRect(r_paddle.r, PAD_PAT);
  492.     end;
  493.  
  494.     procedure create_l_paddle;
  495.     begin
  496.         l_paddle.dir := STOPPED;
  497.         l_paddle.speed := PADDLESPEED;
  498.         l_paddle.score := 0;
  499.         SetRect(l_paddle.r, winstorage.port.portRect.left + PADINSET, winstorage.port.portRect.top + PADINSET, winstorage.port.portRect.left + PADINSET + PADWIDTH, winstorage.port.portRect.top + PADINSET + PADLENGTH);
  500.         FillRect(l_paddle.r, PAD_PAT);
  501.     end;
  502.  
  503.     procedure DoCommand (menu_selection: LongInt);
  504.         var
  505.             the_item: Integer;
  506.             name: Str255;
  507.     begin
  508.         the_item := LoWord(menu_selection);
  509.         case HiWord(menu_selection) of
  510.             appleid: 
  511.                 begin
  512.                     GetItem(gamemenu[0], the_item, name);
  513.                     if OpenDeskAcc(name) <> noErr then
  514.                         ;
  515.                     SetPort(gamewindow);
  516.                 end;
  517.             editid: 
  518.                 if SystemEdit(the_item - 1) then
  519.                     ;
  520.             fileid: 
  521.                 case (the_item) of
  522.                     1: 
  523.                         if (paused) then
  524.                             begin
  525.                                 paused := false;
  526.                                 SetItem(gamemenu[1], 1, 'Pause');
  527.                             end
  528.                         else
  529.                             begin
  530.                                 paused := true;
  531.                                 SetItem(gamemenu[1], 1, 'Continue');
  532.                             end;
  533.                     2: 
  534.                         Init_game;
  535.                     3: 
  536.                         done := true;
  537.                 end;
  538.             skillid: 
  539.                 begin
  540.                     CheckItem(gamemenu[3], skill_level, false);
  541.                     skill_level := the_item;
  542.                     CheckItem(gamemenu[3], skill_level, true);
  543.                 end;
  544.             soundid: 
  545.                 if sound_on then
  546.                     begin
  547.                         sound_on := false;
  548.                         SetItem(gamemenu[4], 1, 'Sound On');
  549.                     end
  550.                 else
  551.                     begin
  552.                         sound_on := true;
  553.                         SetItem(gamemenu[4], 1, 'Sound Off');
  554.                     end;
  555.         end;
  556.         HiliteMenu(0);
  557.     end;
  558.  
  559.     procedure enable_edit_menu;
  560.     begin
  561.         EnableItem(gamemenu[2], 1);
  562.         EnableItem(gamemenu[2], 3);
  563.         EnableItem(gamemenu[2], 4);
  564.         EnableItem(gamemenu[2], 5);
  565.         EnableItem(gamemenu[2], 6);
  566.     end;
  567.  
  568.     procedure disable_edit_menu;
  569.     begin
  570.         DisableItem(gamemenu[2], 1);
  571.         DisableItem(gamemenu[2], 3);
  572.         DisableItem(gamemenu[2], 4);
  573.         DisableItem(gamemenu[2], 5);
  574.         DisableItem(gamemenu[2], 6);
  575.     end;
  576.  
  577.     procedure build_menus;
  578.         var
  579.             i: Integer;
  580.     begin
  581.         InitMenus;
  582.         gamemenu[0] := NewMenu(appleid, '');
  583.         gamemenu[1] := NewMenu(fileid, 'File');
  584.         gamemenu[2] := NewMenu(editid, 'Edit');
  585.         gamemenu[3] := NewMenu(skillid, 'Skill');
  586.         gamemenu[4] := NewMenu(soundid, 'Sound');
  587.         AppendMenu(gamemenu[0], '(About MacPong…;(-');
  588.         AddResMenu(gamemenu[0], 'DRVR');
  589.         AppendMenu(gamemenu[1], 'Pause/P;Restart/R;Quit/Q');
  590.         AppendMenu(gamemenu[2], '(Undo;(-;(Cut;(Copy;(Paste;(Clear');
  591.         AppendMenu(gamemenu[3], 'Beginner;Novice;Normal;Expert');
  592.         AppendMenu(gamemenu[4], 'Sound Off/S');
  593.         for i := 0 to 4 do
  594.             InsertMenu(gamemenu[i], 0);
  595.         CheckItem(gamemenu[3], skill_level, true);
  596.         DrawMenuBar;
  597.     end;
  598.  
  599.     procedure InitSounds;
  600.     begin
  601.         bleep_buf.mode := swMode;
  602.         bleep_buf.triplet[0].count := 1000;
  603.         bleep_buf.triplet[0].amplitude := 255;
  604.         bleep_buf.triplet[0].duration := 5;
  605.         blat_buf.mode := swMode;
  606.         blat_buf.triplet[0].count := 1000;
  607.         blat_buf.triplet[0].amplitude := 255;
  608.         blat_buf.triplet[0].duration := 5;
  609.         blat_buf.triplet[1].count := 3000;
  610.         blat_buf.triplet[1].amplitude := 255;
  611.         blat_buf.triplet[1].duration := 10;
  612.     end;
  613.  
  614.     procedure play_pong;
  615.         var
  616.             startTicks: LongInt;
  617.     begin
  618.         if not paused and ((l_paddle.score < HIGHSCORE) and (r_paddle.score < HIGHSCORE)) then
  619.             begin
  620.                 startTicks := TickCount;
  621.                 if (not ball.on) then
  622.                     serve_ball;
  623.                 check_status;
  624.                 move_left_paddle;
  625.                 move_right_paddle;
  626.                 move_ball;
  627.                 while (startTicks = TickCount) do
  628.                     ;
  629.             end;
  630.     end;
  631.  
  632. (* pretty much straight from SAMP in I.M. *)
  633.     procedure Handle_Events;
  634.         var
  635.             ch: Char;
  636.             mResult: Longint;
  637.             theMenu, theItem: Integer;
  638.     begin
  639.         SystemTask;
  640. {if GetNextEvent(everyEvent, gameEvent) then}
  641.         if GetOSEvent(everyEvent, gameEvent) then
  642.             begin
  643.                 case gameEvent.what of
  644.                     mouseDown: 
  645.                         case FindWindow(gameEvent.where, which_window) of
  646.                             inMenuBar: 
  647.                                 DoCommand(MenuSelect(gameEvent.where));
  648.                             inSysWindow: 
  649.                                 SystemClick(gameEvent, which_window);
  650.                             inDrag: 
  651.                                 DragWindow(which_window, gameEvent.where, dragRect);
  652.                             inContent: 
  653.                                 if (which_window <> FrontWindow) then
  654.                                     SelectWindow(which_window);
  655.                         end;
  656.  
  657.                     keyDown, autoKey: 
  658.                         begin
  659.                             ch := Char(BAnd(gameEvent.message, charCodeMask));
  660.                             mResult := MenuKey(ch);
  661.                             theMenu := HiWord(mResult);
  662.                             theItem := LoWord(mResult);
  663.                             if (theMenu <> 0) then
  664.                                 DoCommand(mResult);
  665.                         end;
  666.  
  667.                     updateEvt: 
  668.                         begin
  669.                             SetPort(gamewindow);
  670.                             BeginUpdate(gamewindow);
  671.                             FillRect(l_paddle.r, PAD_PAT);
  672.                             FillRect(r_paddle.r, PAD_PAT);
  673.                             FillRect(top_wall, WALL_PAT);
  674.                             FillRect(bottom_wall, WALL_PAT);
  675.                             if (ball.on) then
  676.                                 PaintRgn(ball.Rgn);
  677.                             EndUpdate(gamewindow);
  678.                         end;
  679.                 end;
  680.             end;
  681.     end; { Handle_Events}
  682.  
  683.     procedure setup;
  684.     begin
  685.         done := false;
  686.         skill_level := 2;
  687.         sound_on := true;
  688.         last_won := RIGHT;
  689. {$IFC UNDEFINED THINK_PASCAL}
  690.         InitGraf(thePort);
  691.         InitFonts;
  692.         InitWindows;
  693.         TEInit;
  694.         InitDialogs(nil);
  695.         InitCursor;
  696. {$ENDC}
  697.         InitSounds;
  698.  
  699.         pat_Handle := SysPatternHnd(GetResource('PAT#', 0));
  700.         PAD_PAT := pat_Handle^^.pat_list[6];
  701.         WALL_PAT := pat_Handle^^.pat_list[10];
  702.         title := kTitle;
  703.  
  704.         FlushEvents(everyEvent, 0);
  705.         SetRect(r, 4, 40, 508, 338);
  706.         SetRect(dragRect, 4, 24, r.right - 4, r.bottom - 4);
  707.         gamewindow := NewWindow(@winstorage, r, title, true, 0, WindowPtr(-1), false, 0);
  708.         SetPort(gamewindow);
  709.         build_menus;
  710.         ShowCursor;
  711.         create_l_paddle;
  712.         create_r_paddle;
  713.         create_walls;
  714.         create_ball;
  715.         Init_game;
  716.     end;
  717.  
  718. {main}
  719. begin
  720.     setup;
  721.     while (not done) do
  722.         begin
  723.             Handle_Events;
  724.             play_pong;
  725.         end;
  726.     FlushEvents(everyEvent, 0);
  727.     StopSound;
  728.     ExitToShell;
  729. end.